perm filename LI.SAI[SYS,ALS] blob
sn#001162 filedate 1972-05-26 generic text, type T, neo UTF8
00010 BEGIN "LISTEN"
00020 DEFINE ⊂="COMMENT"; ⊂ 5/16/72;
00030 ⊂ This is a fast version of lis.sai;
00090
00100 LABEL LZZZZ;
00110 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00120
00130 REQUIRE "PREPAR[SYS,THO]" LOAD_MODULE;
00140 REQUIRE "SIG[1,ALS]" LOAD_MODULE;
00160 FORTRAN REAL PROCEDURE SQRT(REAL X);
00170 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00180 FORTRAN REAL PROCEDURE COS(REAL X);
00190 FORTRAN REAL PROCEDURE SIN(REAL X);
00200 REQUIRE "FFT8X[1,ALS]" LOAD_MODULE;
00210 EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;REFERENCE REAL X,Y);
00230 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00240
00250 EXTERNAL PROCEDURE PREPARE;
00260 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00270 EXTERNAL PROCEDURE TIMSET;
00280 EXTERNAL REAL PROCEDURE RUNTIM;
00290 EXTERNAL STRING PROCEDURE INCHWL;
00310
00320 DEFINE BPS="12";
00330 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",TABSIZ="7400",LISSIZ="1000",INSIZ="24";
00340 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00350 DEFINE LBYT="ILDB(LBPT)";
00360 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
00370 DEFINE TBLSIZ="250";
00380
00390 STRING FILEL,FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
00400 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00410 INTERNAL INTEGER ARRAY TABLES[0:TABSIZ];
00420 INTERNAL INTEGER ARRAY PHLIST,HLIST[00:63];
00430 INTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00440 INTERNAL INTEGER ARRAY FLIST[0:35];
00450 INTEGER ARRAY LFILE[0:'177];
00460 INTERNAL REAL ARRAY A,B,C[0:256];
00470 REAL X,SX;
00480 REAL ARRAY WINDOW[0:256];
00500 INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00510 INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00520 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
00530 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
00540 INTEGER H,I,J,K,L;
00550 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
00560 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
00570 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
00580 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
00590 ILPB,ILPC, IHPB,IHPC ;
00600 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00610 INTERNAL INTEGER ARRAY TABLET[0:TBLSIZ];
00620 INTERNAL INTEGER TFLAG;
00630 INTERNAL INTEGER ZEROF,ZEROC;
00640
00650 LABEL START;
00660 LABEL LABELA,LABELB,LABELC,ZZZZ;
00670 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
00680 INTEGER HINCNT,HCOUNT,HINDEX;
00690 ⊂ ****SET UP****;
00970 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
00980 BEGIN
00990 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
01000 COMPLEX TRANSFORM ;
01010 INTEGER K,NK,NH;
01020 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
01030 NH←N%2; R←3.1415926536/N;
01040 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
01050 DC←-0.5*R; CK←1.0; SK←0;
01060 IF EVALUATE THEN
01070 BEGIN
01080 CK←-1.0; DC←-DC;
01090 END
01100 ELSE
01110 BEGIN
01120 A[N]←A[0]; B[N]←B[0];
01130 END;
01140 FOR K←0 STEP 1 UNTIL NH DO
01150 BEGIN
01160 NK←N-K;
01170 AA←A[K]+A[NK]; AB←A[K]-A[NK];
01180 BA←B[K]+B[NK]; BB←B[K]-B[NK];
01190 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
01200 B[NK]←IM-BB; B[K]←IM+BB;
01210 A[NK]←AA-RE; A[K]←AA+RE;
01220 DC←R*CK+DC; CK←CK+DC;
01230 DS←R*SK+DS; SK←SK+DS;
01240 END;
01250 END "XRTRAN";
00010 COMMENT MACROS;
00020 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00030 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00040 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00050 DEFINE TIL="STEP 1 UNTIL";
00060 DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
00070 INTEGER K.,J.; ⊂ USED IN MACROS;
00080 DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
00090 DEFINE ISQRT(I)="(K.←(I)↑0.5)";
00100 DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
00110 DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
00120 DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
00130 DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
00140 DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
00150 DEFINE FTRACE(N)=
00160 "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
00170 OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
00180 DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
00190 DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
00200 DEFINE PI="3.141592653",PICON="(PI/180)";
00210 DEFINE INFINITY="'377777777777";
00220 STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
00230
00240 INTERNAL PROCEDURE SETBR;
00250 BEGIN
00260 SETBREAK(1,CR,LF,"IN");
00270 SETBREAK(2,CR&",",LF&TB&" ","IN");
00280 SETBREAK(3,NULL,NULL,"IN");
00290 SETBREAK(4,CR&TB&" ",LF&",","IN");
00300 SETBREAK(5,CR,LF,"ISP"); ⊂ SKIP CR&LF, KEEP LINE NBR AND TAB;
00310 SETBREAK(6,CR&TB&" ",LF&".,","IN");
00320 SETBREAK(7,NULL,0,"I"); ⊂ TO REMOVE NULL CHARACTERS FROM STRING;
00330 SETBREAK(8, "=←;[("&CR , LF&" ])" , "IN");
00340 SETBREAK(9,NULL,0&" "&CR&LF&TB,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE
00350 NUMBERS, NULLS, BLANKS, CR`S, LF`S, TB`S;
00360 SETBREAK(10," "&TB&CR,"0123456789"&LF,"IN");
00370 SETBREAK(11,NULL,0,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE NUMBERS,
00380 AND NULLS;
00390 END "SETBR";
00400
00410
00420 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00430 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00440 BOOLEAN NF;
00450 LOOKUP(CHAN,FILENAME,NF);
00460 WHILE NF DO
00470 BEGIN
00480 OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
00490 FILENAME ← INPUT(TTY,1);
00500 LOOKUP(CHAN,FILENAME,NF)
00510 END;
00520 END "LOOKIN";
01270
01280 STRING PROCEDURE HEADER;
01290 BEGIN STRING H1,H2; INTEGER I,J,K;
01300 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
01310 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
01320 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
01330
01340 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
01350 IF J ≥ 0 THEN BEGIN "LATCH"
01360 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
01370 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
01380 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
01390 HCOUNT←HCOUNT-J;
01400 HINDEX←HINDEX+1; RETURN(PREHINT); DONE
01410 END
01420 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
01430 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
01440 END;
01450 END "LATCH";
01460 PREHINT←""; RETURN(PREHINT); END "XX";
01470 END "HEADER";
01480
00010 SETBR;
00020 UPCNT←3;
00030 FILEL←"LIST1";
00040 FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00050 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00060 CLOSE(CHAN1);
00070 OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00080 LOOKUP(CHAN1,"TABLES.DAT",0);
00090 ARRYIN(CHAN1,INSUB[0],INSIZ);
00100 ARRYIN(CHAN1,INDIV[0],INSIZ);
00110 ARRYIN(CHAN1,INCNT[0],INSIZ);
00120 ARRYIN(CHAN1,INNAM[0],INSIZ);
00130 ARRYIN(CHAN1,FLIST[0],36);
00140 ARRYIN(CHAN1,PHLIST[0],64);
00150 ARRYIN(CHAN1,HLIST[0],64);
00160 ARRYIN(CHAN1,TABLES[0],TABSIZ);
00170 ARRYIN(CHAN1,TABLET[0],TBLSIZ);
00180
00190 CLOSE(CHAN5); CLOSE(CHAN6);
00200 OPEN(CHAN5,"DSK",'10,10,0,0,0,EOF);
00210 LOOKUP(CHAN5,"SIGLST.DAT",0);
00220 ARRYIN(CHAN5,LIST[0],LISSIZ);
00230 INTOT←WORDIN(CHAN5);
00240 RELEASE(CHAN5);
00250
00260 START:
00270 IF (TFILEI←STRIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
00290 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00300 LOOKUP(CHAN5,FILEL,1); EOFA←0;
00320
00330 M←8;
00340 N←2↑M; NF←2*N;
00350 FOR I←0 STEP 1 UNTIL N DO
00360 WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00370
00380 N←2↑M;
00390 STPMOD←STRIN(CRLF&"Should HINTS be listed on scope? (Y or CR) = ");
00410 OUTSTR(CRLF&"Shift DATABUF by WORDS = ");
00420 DATSHIFT←CVD(INCHWL); ⊂ USE TO TEST PHASE SENSITIVITY OF LEARNING;
00425 OUTSTR(CRLF);
00430 WHILE EOFA=0 DO BEGIN "LISTREAD"
00435 HINDEX←21; HCOUNT←HINCNT←0; OPT1←"Y"; OPT2←"N"; STEPX←"Y";
00440 LABELB: FILEI←INPUT(CHAN5,1);
00450 CLOSE(CHAN4);
00460 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00470 LOOKIN(CHAN4,FILEI);
00480 EOF←0; SEGC←0; SEGCNT←0;
00490 LABELC: ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00500 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00505
00510 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00520 OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segments"&CRLF);
00540 ⊂ **** SET PARAMETER RANGES
00550 THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
00560 NP=800/1500 NZRNG=NP+/-500 ?
00570 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
00580 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00590 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
00600 I3L←1950./SX; I3H←3250./SX+.5;
00610 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
00620 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
00630 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
00640 BPTFST←POINT(BPS,DATBUF[0],-1);
00650 IF DATSHIFT>0 THEN
00660 ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00670 ARRYIN(CHAN4,DATBUF[0],BUFEXS);
00680 SEGMRK←SEGC←K←1;
00690 WHILE EOF=0 DO
00700 BEGIN
00710 IF SEGC>SEGTOT THEN DONE;
00720 ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
00730
00740 IF EOF≠0 THEN
00750 BEGIN
00760 J←EOF LAND '777777;
00770 FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0;
00780 END;
00790 IF SEGMRK<SEGC+30 THEN BEGIN "FOUND"
00800 K←1;
00810
00820 BPT←BPTFST; SEGSAV←SEGC;
00830 LZZZZ: WHILE K≤6*DATSIZ%N DO BEGIN
00840 IF (J←SEGMRK-SEGC)>0 THEN BEGIN
00850 FOR I←1 STEP 1 UNTIL J DO BEGIN
00860 BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
00870 K←K+J; SEGC←SEGMRK; END;
00880 IF SEGC>SEGTOT THEN DONE;
00890 IF K>6*DATSIZ%N THEN DONE;
00900
00910 BPTSAV←BPT;
00920
00930 I←0; WHILE I≥0 DO BEGIN
00940 READ1←HEADER; IF STPMOD="Y" THEN OUTSTR(" ("&CVS(SEGC)&")"&READ1);
00950 IF READ1="" THEN BEGIN SEGMRK←SEGC+1; DONE END;
00960 J←CVSIX(READ1);
00970 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00980 IF PHLIST[I]=0 THEN BEGIN SEGMRK←SEGC+1;OUTSTR("Hint not identified for segment "&CVS(SEGC)&CRLF);DONE END;
00990 IF PHLIST[I]=J THEN BEGIN
01000 HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
01010 END;
01020 IF I<64 THEN BEGIN SEGMRK←SEGC+1; DONE END;
01030 END;
01040 IF READ1≠"" THEN BEGIN
01045 HINCNT←HINCNT+1;
01050 J←I←ZEROC←0; A[J]←BYTE*WINDOW[I]; B[J]←BYTE*WINDOW[I+1]; J←J+1;
01060 IF B[J]<A[J] THEN ZEROF←0 ELSE ZEROF←1;
01070 FOR I←2 STEP 2 UNTIL N-1 DO
01080 BEGIN
01090 A[J]←BYTE*WINDOW[I];
01100 IF A[J]<B[J-1] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01110 B[J]←BYTE*WINDOW[I+1];
01120 IF B[J]<A[J] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01130 J←J+1;
01140 END;
01150 FRXFM(M-1,A[0],B[0]);
01160 XRTRAN(A,B,N/2,FALSE);
01170 FOR I←0 STEP 1 UNTIL N/2 DO C[I]←5.*ALOG10(A[I]↑2+B[I]↑2);
01180 END; ⊂ End of first IF READ1="" ;
01190 IF READ1≠"" THEN BEGIN
01200 PREPARE;
01210
01220 ZZZZ: SIG(P);
01410 END; ⊂ END of second IF READ1≠"" ;
01420 IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE;
01430 END; ⊂ End of WHILE K≤ ;
01440 END "FOUND";
01450 SEGC←SEGSAV+6*DATSIZ%N; K←1;
01460 FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
01470 FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0;
01480 END;
01490 CLOSE(CHAN1);
01500 OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
01510 ENTER(CHAN2,"TABLES.DAT",0);
01520 ARRYOUT(CHAN2,INSUB[0],INSIZ);
01530 ARRYOUT(CHAN2,INDIV[0],INSIZ);
01540 ARRYOUT(CHAN2,INCNT[0],INSIZ);
01550 ARRYOUT(CHAN2,INNAM[0],INSIZ);
01560 ARRYOUT(CHAN2,FLIST[0],36);
01570 ARRYOUT(CHAN2,PHLIST[0],64);
01580 ARRYOUT(CHAN2,HLIST[0],64);
01590 ARRYOUT(CHAN2,TABLES[0],TABSIZ);
01600 ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
01610 CLOSE(CHAN2);
01615 IF STPMOD="Y" THEN OUTSTR(CRLF);
01620 OUTSTR("Tables have been saved with "&CVS(HINCNT)&" hints found"&CRLF);
01630 END "LISTREAD";
01640 GO TO START;
01650 END "LISTEN";